# TEXT WRANGLING ---------------------------------------------------------------

#' Extracts characters from the beginning ("left)") of a string.
#' @param string Character: string/character entry
#' @param char Integer: how many characters to go from the beginning of 'string'
#' @return Character: A string extract
extr_left_substr <- function(string, char) {
  substr(string, 1, char)
}

#' Extracts characters from the end ("right") of a string.
#' @param string Character: string/character entry
#' @param char Integer: how many characters to go from the end of 'string'
#' @return Character: A string extract
extr_right_substr <- function(string, char) {
  substr(string, nchar(string) - (char - 1), nchar(string))
}

# FORMATTING NUMERIC DATA FOR TEXT/REPORTING -----------------------------------

#' Utility function for formatting numeric data (mostly for table production).
#' @param input Non-character: (expected) number-type (scalar/vector) entry
#' @param sub_for_missing Character: replaces missing 'input'; default is "-"
#' @param should_be_rounded Logical: TRUE (default) rounds 'input'; else not
#' @param round_digits Integer: input for round(); default is 2, nearest decimal
#' @param decimal_digits Integer: display digits of 'input' after decimal point
#' @param scale_factor Integer: scale 'input' by factor (e.g., unit conversion)
#' @param add_comma Logical: FALSE (default) yields "1000"; else "1,000"
#' @return  output Character: formatted version of 'input'
fmt_fixed_decimal <-
  function(input,
           sub_for_missing = "-",
           should_be_rounded = TRUE,
           round_digits = 2L,
           decimal_digits = 2L,
           scale_factor = NA,
           add_comma = FALSE) {

    # Check that 'input' is a number or logical / all numbers or all logicals
    if (
      !(typeof(input) %in% c("logical", "integer", "double", "complex", "NULL"))
    ) {
      stop_message_part1 <-
        sprintf(
          "Found element(s) of '%s' that are not in c('logical', 'integer', 'double', 'complex', 'NULL')", #nolint
          deparse(substitute(input)
        ))
      stop_message_part2 <-
        sprintf("Please check '%s' and try again", deparse(substitute(input)))

      stop(sprintf("%s. %s.", stop_message_part1, stop_message_part2))
    }

    if (length(input) == 0) {
      # For the case where 'input' isn't anything, such as 0+ NULLs or an
      # empty data.table, replace with the desired 'sub_for_missing' character
      output <- copy(sub_for_missing)
    } else if (
      all(
        is.null(input) | is.na(input) | is.infinite(input) | is.nan(input)
      )
    ) {
      # For the case case where 'input' is *all* NULL/NA/Inf/-Inf/NaN
      # replace with the desired 'sub_for_missing' character
      output <- copy(sub_for_missing)
    } else {
      # Multiply by 'scale_factor' if supplied
      if (!is.na(scale_factor)) {
        input <- input * scale_factor
      }

      # Round 'input' to conform to desired number of digits ('round_digits')
      if (should_be_rounded == TRUE) {
        input <- round(input, digits = round_digits)
      }

      # For scalar 'input', we could start text/character formatting now
      # but for vector where some (but not all) values are NULL/NA/Inf/-Inf/NaN
      # replace with NA for common treatment later
      # $@$ CHECK WHETHER NEED all() VERSION OF THIS GIVEN THIS LINE BELOW $@$
      input[
        is.null(input) | is.na(input) | is.infinite(input) | is.nan(input)
        ] <- NA

      output <-
        trimws(format(
          input,
          digits = max(decimal_digits, 1L), # needs to be positive integer
          nsmall = max(decimal_digits, 0L), # need to be integer in [0,20]
          big.mark = ifelse((add_comma == TRUE),
                            ",",
                            "")
        ))

      # Address NA cases converted above
      output[output == "NA"] <- copy(sub_for_missing)
    }
    return(output)
  }

# TEX TABLE CREATION -----------------------------------------------------------

#' Open a customized booktabs TeX environment in R, e.g., \begin{tabular}{ccc}.
#' Relies on having \usepackage{booktabs} in the relevant TeX preamble
#' @param column_structure Character: column instructions, e.g., "l|c|c|c"
#' @param file_dir Character: the full path to TeX file ("connection")
#' @param append Logical: TRUE (default) appends to "connection"; else replaces
start_latex_table <- function(column_structure, file_dir, append = TRUE) {
  write(
    sprintf("\\begin{tabular}{%s}", column_structure),
    file_dir,
    append = append
  )
}

#' Write a customized line of TeX tabular input. Relies on having
#' \usepackage{booktabs} in the relevant TeX preamble and already started a
#' \begin{tabular} TeX environment.
#' @param input Character: full text of TeX tabular input, e.g., "1 & ABC"
#' @param file_dir Character: the full path to TeX file ("connection")
#' @param short_row_height Logical: default is full height row
#' @param append Logical: TRUE (default) appends to "connection"; else replaces
write_latex_table_row <-
    function(input, file_dir, short_row_height = FALSE, append = TRUE) {
        if (short_row_height == FALSE) {
            write(sprintf("%s \\\\", input), file_dir, append = append)
            # need the "\\\\" for proper escaping to yield lin end "\\" in TeX
            # (one additional "\" for each desired "\")
        } else {
            write(sprintf("%s \\\\[-2ex]", input), file_dir, append = append)
            # need the "\\\\" for proper escaping to yield lin end "\\" in TeX
            # (one additional "\" for each desired "\")  \\[-2ex]
        }
    }

#' Add a \*rule (top, mid, bottom) from TeX's booktabs to an open TeX file in R.
#' Relies on having \usepackage{booktabs} in the relevant TeX preamble and
#' already started a \begin{tabular} TeX environment.
#' @param rule_type Character: either "toprule", "midrule", or "bottomrule"
#' @param file_dir Character: the full path to TeX file ("connection")
#' @param append Logical: TRUE (default) appends to "connection"; else replaces
add_latex_table_rule <- function(rule_type, file_dir, append = TRUE) {
  write(sprintf("\\%s", rule_type), file_dir, append = append)
  # need the "\\" to properly escape the character when writing
}

#' Add a customized \cmidrule() from TeX's booktabs with given start column
#' and length to an open TeX file in R.  Relies on having \usepackage{booktabs}
#' in the relevant TeX preamble and already started a \begin{tabular} TeX
#' environment.
#' @param point_start_col Character: Whether to start from the left corner ("l"), right corner ("r") or center ("c") of "start_col" #nolint
#' @param point_end_col Character: Whether to end on the left corner ("l"), right corner ("r") or center ("c") of "end_col" #nolint
#' @param start_col Integer: Column to start \cmidrule
#' @param end_col Integer: Column to end \cmidrule
#' @param file_dir Character: the full path to TeX file ("connection")
#' @param append Logical: TRUE (default) appends to "connection"; else replaces
add_latex_cmidrule <-
  function(
    point_start_col,
    point_end_col,
    start_col,
    end_col,
    file_dir,
    append = TRUE) {
  write(
    sprintf(
      "\\cmidrule(%s%s){%s-%s}",
      point_start_col,
      point_end_col,
      start_col,
      end_col
    ),
    file_dir,
    append = append
  )
  # need the "\\" to properly escape the character when writing
}

#' Close a booktabs TeX environment in R, i.e., \end{tabular}. Relies on
#' having \usepackage{booktabs} in the relevant TeX preamble and already
#' started a \begin{tabular} TeX environment.
#' @param file_dir Character: the full path to TeX file ("connection")
#' @param append Logical: TRUE (default) appends to "connection"; else replaces
end_latex_table <- function(file_dir, append = TRUE) {
  write("\\end{tabular}", file_dir, append = append)
}